A4_skobsar
Stefanie Kobsar
6/12/2020
df_seats <- read.csv("ChildCarSeats1.csv")
head(df_seats)## Sales CompPrice Income Advertising Population Price ShelveLoc Age
## 1 9.50 138 73 11 276 120 Bad 42
## 2 11.22 111 48 16 260 83 Good 65
## 3 10.06 113 35 10 269 80 Medium 59
## 4 7.40 117 100 4 466 97 Medium 55
## 5 4.15 141 64 3 340 128 Bad 38
## 6 10.81 124 113 13 501 72 Bad 78
## Education Urban US
## 1 17 Yes Yes
## 2 10 Yes Yes
## 3 12 Yes Yes
## 4 14 Yes Yes
## 5 13 Yes No
## 6 16 No Yes- Sales (Ventas unitarias, en miles, en cada ubicación).
- CompPrice (Precio que cobra el competidor en cada ubicación).
- Income (Nivel de ingresos comunitarios, en miles de dólares).
- Advertising (Presupuesto de publicidad local de la empresa en cada ubicación, en miles de dólares).
- Population (Tamaño de la población en la región, en miles).
- Price (Precio del producto en cada ubicación).
- ShelveLoc (Un factor con niveles Bad, Good y Medium que indica la calidad de la ubicación del producto en los puntos de venta).
- Age (Edad media de la población local).
- Education (Nivel educativo).
- Urban (Un factor con los niveles Yes y No, que indica si la tienda está en una ubicación rural o urbana).
- US (Un factor con los niveles Yes y No para indicar si la tienda se encuentra en USA o no).
#type of data
df_seats <- df_seats[, c((1:6), 9, 8, 7, 10, 11)]
str(df_seats)## 'data.frame': 400 obs. of 11 variables:
## $ Sales : num 9.5 11.22 10.06 7.4 4.15 ...
## $ CompPrice : int 138 111 113 117 141 124 115 136 132 132 ...
## $ Income : int 73 48 35 100 64 113 105 81 110 113 ...
## $ Advertising: int 11 16 10 4 3 13 0 15 0 0 ...
## $ Population : int 276 260 269 466 340 501 45 425 108 131 ...
## $ Price : int 120 83 80 97 128 72 108 120 124 124 ...
## $ Education : int 17 10 12 14 13 16 15 10 10 17 ...
## $ Age : int 42 65 59 55 38 78 71 67 76 76 ...
## $ ShelveLoc : Factor w/ 3 levels "Bad","Good","Medium": 1 2 3 3 1 1 3 2 3 3 ...
## $ Urban : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 1 2 2 1 1 ...
## $ US : Factor w/ 2 levels "No","Yes": 2 2 2 2 1 2 1 2 1 2 ...Las variables categoricas (factor) son ShelveLoc, Urban y US. Todas las demás son variables numéricas (double o integer).
#Presencia de na
sapply(df_seats, function(x) sum(is.na(x)))## Sales CompPrice Income Advertising Population Price
## 0 0 0 0 0 0
## Education Age ShelveLoc Urban US
## 0 0 0 0 0No hay missing values en el dataframe proporcionado.
summary(df_seats)## Sales CompPrice Income Advertising
## Min. : 0.000 Min. : 77 Min. : 21.00 Min. : 0.000
## 1st Qu.: 5.390 1st Qu.:115 1st Qu.: 42.75 1st Qu.: 0.000
## Median : 7.435 Median :125 Median : 69.00 Median : 5.000
## Mean : 7.410 Mean :125 Mean : 68.66 Mean : 6.635
## 3rd Qu.: 9.160 3rd Qu.:135 3rd Qu.: 91.00 3rd Qu.:12.000
## Max. :16.270 Max. :175 Max. :120.00 Max. :29.000
## Population Price Education Age
## Min. : 10.0 Min. : 24.0 Min. :10.0 Min. :25.00
## 1st Qu.:139.0 1st Qu.:100.0 1st Qu.:12.0 1st Qu.:39.75
## Median :272.0 Median :117.0 Median :14.0 Median :54.50
## Mean :264.8 Mean :115.8 Mean :13.9 Mean :53.32
## 3rd Qu.:398.5 3rd Qu.:131.0 3rd Qu.:16.0 3rd Qu.:66.00
## Max. :509.0 Max. :191.0 Max. :18.0 Max. :80.00
## ShelveLoc Urban US
## Bad : 96 No :118 No :142
## Good : 85 Yes:282 Yes:258
## Medium:219
##
##
## Sales: Corresponde a los datos de ventas unitarias de sillas, en miles. La media y la mediana estan muy proximas, y eso puede ser un indicativo de una distribución normal. El límite del primer cuartil es 5.390 y el del tercer cuartil 9.160.
ComPrice: Precio de venta de los competidores. La media y la mediana coinciden exactamente. El rango de precios está comprendido entre 77 y 175.
Income: Corresponde al nivel de ingresos. La media también es muy próxima a la mediana. El rango es más amplio, ya que comprende valores desde 21 a 120,
Las varibales anteriores se expresan en función de las diferentes poblaciones. Advertising: Media (6.635) y mediana difieren en 1.6 unidades. El tercer cuartil empieza en 12. El valor máximo es de 29, es posible que este valor cree el desplazamiento de la mediana. Hay que evaluar los outliers de esta variable.
Population: Tamaño de cada una de las poblaciones, en miles. El rango es desde 139 a 509. Se puede ver que se trabaja con poblaciones de tamaños dispares. La media se encuentra más cercana a los rangos inferiores que a los superiores (264.8). La media y la mediana son semejantes.
Price: Precio del producto en cada ubicación. Se observa una variación importante en el precio dependiendo de donde es vendido el producto.
Age: edad media de la población local. Se observa que la media es de 53 años. Se observa que el 75% de la población se encuentra por debajo de los 66 años.
Shevloc, urban y US: Son variables dicotómicas.
boxplot(df_seats$Sales~df_seats$ShelveLoc)
ShelveLoc es la variable que indica la calidad de la ubicación del producto en los puntos de venta. En este caso hay 3 niveles: bad, medium y good. Se puede ver el numero de ventas podría estar condicionado por la ubicación de los productos en la tienda.
Se observa que la media de ventas aumenta respecto a las ubicaciones (media(bad)<media(medium)<media(good)). Se observa que en medium existen algunos datos outliers. Esto puede ser debido a la dificultad para clasificar las ubicaciones en únicamente tres niveles.
Este análisis puede darnos una idea preliminar de que la ubicación puede ser un factor relevante. Habría que correlacionar esta variable con la demás para encontrar alguna relación de significancia.
boxplot(df_seats$Sales~df_seats$Urban)
Urban es un factor con los niveles Yes y No, que indica si la tienda está en una ubicación rural o urbana. Al parecer, no existe ninguna diferencia significativa en este factor en concreto en relación a las ventas. Puede observarse que el rango de valores en función de Urban~Yes está ligeramente más acotado que el de Urban~No, pero a su vez se observan outliers en Urban~Yes, lo que hace que el análisis preliminar no sea muy concluyente.
boxplot(df_seats$Sales~df_seats$US)
US es un factor con los niveles Yes y No para indicar si la tienda se encuentra en USA o no. Se puede apreciar que la mayor parte de las ventas se encuentras en USA, aunque las medias de ambos subsets son próximas.
Que las medias sena próximas entre si no nos da mucha información ya que puede deberse a la casualidad, puede ser una consecuencia del teorema del límite central o puede ser in dato interesante siempre y cuando se contextualice correctamente.
REPRESENTACIÓN GRÁFICA
library(ggplot2)
ggplot(df_seats, aes(x=as.factor(ShelveLoc), fill=as.factor(ShelveLoc) )) +
geom_bar( ) +
scale_fill_brewer(palette = "Set3") +
theme(legend.position="none")
ggplot(df_seats, aes(x=as.factor(Urban), fill=as.factor(Urban) )) +
geom_bar( ) +
scale_fill_brewer(palette = "Set3") +
theme(legend.position="none")
ggplot(df_seats, aes(x=as.factor(US), fill=as.factor(US) )) +
geom_bar( ) +
scale_fill_brewer(palette = "Set2") +
theme(legend.position="none")
pairs(df_seats[,1:8], pch = 19, lower.panel = NULL)
ggplot(df_seats, aes(x=CompPrice, y=Price)) +
geom_point(shape=1) + # Use hollow circles
geom_smooth(method=lm) # Add linear regression line ## `geom_smooth()` using formula 'y ~ x'
# (by default includes 95% confidence region)ggplot(df_seats, aes(x=Sales, y=Price)) +
geom_point(shape=1) + # Use hollow circles
geom_smooth(method=lm) # Add linear regression line ## `geom_smooth()` using formula 'y ~ x'
# (by default includes 95% confidence region)ggplot(df_seats, aes(x=CompPrice, y=Population)) +
geom_point(shape=1) + # Use hollow circles
geom_smooth(method=lm) # Add linear regression line ## `geom_smooth()` using formula 'y ~ x'
# (by default includes 95% confidence region)ggplot(df_seats, aes(fill=Population, y=Sales, x=Education)) +
geom_bar(position="dodge", stat="identity")
ggplot(df_seats, aes(fill=Advertising, y=Sales, x=Education)) +
geom_bar(position="dodge", stat="identity",)
ggplot(df_seats, aes(fill=Population, y=Advertising, x=Education)) +
geom_bar(position="dodge", stat="identity")
ggplot(df_seats, aes(fill=Sales, y=ShelveLoc, x=US)) +
geom_bar(position="dodge", stat="identity")
ESTADÍSTICA INFERENCIAL
2.1. Intervalo de confianza de la variable Price
int_conf_95 <- function(mean_data, desvest, obs) {
lower_value <- mean_data-(1.96*(desvest/sqrt(obs)))
upper_value <- mean_data+(1.96*(desvest/sqrt(obs)))
print(lower_value)
print(upper_value)
}mean_price <- mean(df_seats$Price)
sd_price <- sd(df_seats$Price)
obs_price <- nrow(df_seats)
int_conf_95(mean_data = mean_price, desvest = sd_price, obs = obs_price)## [1] 113.4747
## [1] 118.1153El intervalo de confiaza de la variable Price está comprendido entre 113 y 118.
Comprobación usando la función t.test;
t.test(df_seats$Price)##
## One Sample t-test
##
## data: df_seats$Price
## t = 97.814, df = 399, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
## 113.4677 118.1223
## sample estimates:
## mean of x
## 115.7952.2. Test de comparación de dos medias
¿Se puede afirmar que en las tiendas de USA (variable US) el promedio de ventas de sillas de coche infantiles (variable Sales) es superior a la media de ventas en tiendas fuera de USA? Realizad los cálculos para un nivel de confianza del 95 %.
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondf_seats_US <- subset(df_seats, US == "Yes")
df_seats_no_US <- subset(df_seats, US == "No")
hist(df_seats_US$Sales)
hist(df_seats_no_US$Sales)
Test de normalidad:
library(normtest)
jb.norm.test(df_seats_US$Sales)##
## Jarque-Bera test for normality
##
## data: df_seats_US$Sales
## JB = 1.5123, p-value = 0.4465library(normtest)
jb.norm.test(df_seats_no_US$Sales)##
## Jarque-Bera test for normality
##
## data: df_seats_no_US$Sales
## JB = 2.1346, p-value = 0.2765Los dos subsets de datos siguen una distrubución normal, y por lo tanto, pueden ser comparados entre ellos.
Comparación de varianzas:
var.test(df_seats_US$Sales, df_seats_no_US$Sales)##
## F test to compare two variances
##
## data: df_seats_US$Sales and df_seats_no_US$Sales
## F = 1.667, num df = 257, denom df = 141, p-value = 0.0008679
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
## 1.237737 2.217092
## sample estimates:
## ratio of variances
## 1.666969Se confirma hipotesis alternativa, es decir, las varianzas son significativamente diferentes con un intervalo de confianza del 95%. Se quiere comparar la media de ventas en las tiendas de USA y las de fuera de USA.
Se establecen las hipótesis:
Ho: μ1 - μ2 = 0 H1: μ1 - μ2 diferente de 0
Para calcular el estadístico de contraste de dos muestras independientes, se hará una nueva función:
z_two_samples <- function(mean1, mean2, var1, var2, n1, n2){
std_error <- sqrt((var1/n1)+(var2/n2))
z <- (mean1-mean2)/(std_error)
print(z)
}mean_sales_us <- mean(df_seats_US$Sales)
mean_sales_no_us <- mean(df_seats_no_US$Sales)
var_sales_us <- var(df_seats_US$Sales)
var_sales_no_us <- var(df_seats_no_US$Sales)
nobs_sales_us <- nrow(df_seats_US)
nobs_sales_no_us <- nrow(df_seats_no_US)
z_sales <- z_two_samples(mean1 = mean_sales_us, mean2 = mean_sales_no_us, var1 = var_sales_us, var2 = var_sales_no_us, n1 = nobs_sales_us, n2 = nobs_sales_no_us)## [1] 4.970486Para calcular el p valor necesitamos saber los grados de libertad.
freedom <- function(var1, var2, n1, n2){
num <- ((var1/n1)+(var2/n2))^2
den1 <- (((var1/n1)^2)/(n1-1))
den2 <- (((var2/n2)^2)/(n2-1))
degree_freedom <- num/(den1+den2)
print(degree_freedom)
}
dof <- freedom(var1 = var_sales_us, var2 = var_sales_no_us, n1 = nobs_sales_us, n2 = nobs_sales_no_us)## [1] 354.6376Cálcuo del p-valor
PZ <- pnorm(z_sales, dof)
p_value <- 2*PZ
p_value## [1] 0Conclusión:
En este caso se ha obtenido un p-valor = 0, que es menor que 0.05. En este caso, se rechaza la hipótesis nula, o lo que es lo mismo, las medias de ambas muestras son significativamente diferentes con un 95% de confianza.
Comprobación del cálculo con la funcion t.test.
t.test(df_seats_US$Sales, df_seats_no_US$Sales, var.equal=FALSE)##
## Welch Two Sample t-test
##
## data: df_seats_US$Sales and df_seats_no_US$Sales
## t = 4.9705, df = 354.64, p-value = 1.042e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.7778386 1.7963824
## sample estimates:
## mean of x mean of y
## 7.866899 6.5797892.3. Constraste no paramétrico
En el apartado anterior, se ha asumido normalidad de la variable ventas (Sales). Independientemente de si podemos asumir normalidad, en este apartado os pedimos aplicar un test no paramétrico para responder si las ventas de sillas infantiles es superior en USA que fuera de USA. Podéis usar funciones de R para el contraste, sin necesidad de realizar el contraste manualmente.
Wilcoxon Signed-Rang Test:
Ho: poblaciones identicas. H1: poblaciones no identicas.
wilcox.test(df_seats_US$Sales, df_seats_no_US$Sales)##
## Wilcoxon rank sum test with continuity correction
##
## data: df_seats_US$Sales and df_seats_no_US$Sales
## W = 23084, p-value = 1.651e-05
## alternative hypothesis: true location shift is not equal to 0Las poblaciones son significativamente diferentes con un nivel de confianza de 95%.
- Regresión
3.1. Modelo de regresión lineal
Aplicar un modelo de regresión lineal múltiple que tenga como variables explicativas: Price, Advertising, Age, Population, ShelveLoc, US, y Urban, y como variable dependiente las ventas, la variable Sales. Especificad el nivel base de referencia, usando la función relevel:
- para la variable ShelveLoc, la categoría “Bad”,
- para la variable US, la categoría “Yes”,
- para la variable Urban, la categoría “Yes”.
relevel(df_seats$ShelveLoc, ref = "Bad")## [1] Bad Good Medium Medium Bad Bad Medium Good Medium Medium
## [11] Bad Good Medium Good Good Medium Good Good Good Medium
## [21] Medium Good Medium Medium Bad Good Good Medium Bad Bad
## [31] Good Medium Good Good Medium Medium Good Medium Medium Bad
## [41] Bad Bad Medium Medium Medium Bad Medium Bad Bad Good
## [51] Bad Bad Bad Medium Medium Medium Medium Bad Bad Medium
## [61] Bad Medium Bad Medium Medium Medium Medium Medium Good Medium
## [71] Good Medium Medium Good Medium Bad Medium Medium Medium Bad
## [81] Bad Good Good Bad Bad Medium Medium Good Medium Medium
## [91] Medium Medium Medium Medium Bad Medium Good Bad Good Bad
## [101] Medium Medium Medium Bad Medium Medium Medium Medium Bad Medium
## [111] Medium Medium Good Bad Medium Medium Medium Medium Medium Medium
## [121] Medium Bad Medium Good Good Medium Good Medium Bad Bad
## [131] Medium Medium Good Bad Medium Medium Bad Medium Medium Medium
## [141] Medium Bad Medium Bad Good Medium Bad Good Medium Medium
## [151] Good Good Good Medium Medium Medium Good Medium Good Bad
## [161] Medium Medium Medium Bad Medium Bad Medium Medium Medium Good
## [171] Medium Medium Good Medium Medium Medium Medium Medium Medium Medium
## [181] Bad Medium Bad Medium Medium Medium Medium Bad Medium Medium
## [191] Medium Good Medium Good Medium Bad Bad Medium Medium Medium
## [201] Medium Medium Bad Bad Medium Medium Medium Bad Bad Bad
## [211] Bad Medium Medium Medium Medium Bad Medium Medium Medium Good
## [221] Medium Medium Medium Medium Medium Bad Good Medium Bad Medium
## [231] Bad Medium Good Medium Good Medium Medium Medium Good Bad
## [241] Medium Medium Medium Medium Medium Good Bad Bad Medium Bad
## [251] Good Bad Medium Medium Good Bad Medium Medium Bad Bad
## [261] Bad Medium Medium Medium Good Bad Good Bad Medium Medium
## [271] Good Medium Good Medium Medium Medium Medium Medium Good Medium
## [281] Bad Good Good Medium Bad Medium Medium Bad Medium Medium
## [291] Medium Bad Good Good Good Medium Good Bad Good Medium
## [301] Medium Medium Bad Medium Good Medium Medium Bad Medium Bad
## [311] Medium Bad Bad Medium Good Good Good Good Good Medium
## [321] Medium Medium Good Medium Bad Medium Medium Medium Bad Good
## [331] Bad Medium Medium Medium Bad Medium Bad Medium Medium Good
## [341] Bad Medium Medium Bad Good Good Medium Good Good Medium
## [351] Medium Medium Good Medium Medium Good Good Medium Bad Bad
## [361] Good Medium Bad Good Good Medium Medium Good Good Medium
## [371] Bad Medium Medium Medium Medium Medium Good Medium Medium Bad
## [381] Medium Bad Medium Medium Good Medium Medium Medium Bad Medium
## [391] Medium Bad Bad Medium Bad Good Medium Medium Bad Good
## Levels: Bad Good Mediumrelevel(df_seats$US, ref = "Yes")## [1] Yes Yes Yes Yes No Yes No Yes No Yes Yes Yes No Yes Yes No No
## [18] Yes Yes Yes Yes Yes No No Yes No Yes No Yes Yes No Yes Yes Yes
## [35] Yes Yes No Yes No No No No No Yes Yes Yes Yes No No No Yes
## [52] No Yes Yes Yes Yes No No Yes No Yes No Yes Yes Yes No No Yes
## [69] Yes No Yes Yes No Yes Yes Yes Yes Yes Yes No Yes No Yes Yes No
## [86] No No Yes Yes No No Yes No No Yes Yes Yes Yes Yes Yes Yes No
## [103] No Yes No Yes No No No No Yes Yes Yes Yes Yes No No No Yes
## [120] Yes Yes Yes Yes Yes No No Yes Yes Yes Yes Yes No Yes Yes No Yes
## [137] No No Yes Yes Yes No No Yes No Yes No Yes Yes Yes Yes Yes No
## [154] Yes Yes No No Yes Yes No No Yes No No Yes Yes Yes No No Yes
## [171] Yes Yes Yes Yes No No Yes Yes Yes Yes Yes No No Yes Yes Yes No
## [188] No No Yes Yes Yes No Yes Yes Yes Yes No Yes Yes No No Yes No
## [205] No No Yes No No Yes Yes Yes Yes Yes Yes Yes No No Yes Yes Yes
## [222] No Yes Yes No No No Yes Yes No No No Yes Yes Yes Yes Yes Yes
## [239] No Yes No No No Yes No Yes Yes No Yes No Yes Yes No Yes Yes
## [256] Yes No Yes No Yes Yes Yes Yes Yes Yes Yes Yes Yes No No No No
## [273] No Yes Yes Yes Yes Yes Yes Yes Yes Yes No No No Yes Yes Yes No
## [290] Yes Yes No Yes No Yes Yes Yes Yes No Yes Yes Yes Yes Yes Yes Yes
## [307] Yes No Yes Yes Yes Yes Yes No Yes Yes Yes No Yes Yes Yes No Yes
## [324] Yes Yes Yes No Yes Yes Yes No Yes Yes Yes Yes Yes No No No Yes
## [341] No No Yes Yes Yes No No No Yes Yes Yes Yes Yes Yes Yes No No
## [358] Yes Yes Yes Yes Yes Yes No Yes No Yes No Yes Yes Yes No No No
## [375] Yes No Yes No Yes No Yes Yes Yes No Yes Yes No Yes Yes Yes Yes
## [392] No Yes Yes Yes Yes Yes Yes Yes Yes
## Levels: Yes Norelevel(df_seats$Urban, ref = "Yes")## [1] Yes Yes Yes Yes Yes No Yes Yes No No No Yes Yes Yes Yes No Yes
## [18] Yes No Yes Yes No Yes Yes Yes No No Yes Yes Yes Yes Yes No Yes
## [35] Yes No No Yes Yes No No Yes Yes Yes Yes Yes No Yes Yes Yes Yes
## [52] Yes Yes Yes No Yes Yes Yes Yes Yes Yes No Yes Yes No No Yes Yes
## [69] Yes Yes Yes No Yes No No No Yes No Yes Yes Yes Yes Yes Yes No
## [86] No Yes No Yes No No Yes Yes Yes Yes Yes No Yes No No No Yes
## [103] No Yes Yes Yes No Yes Yes No Yes Yes Yes Yes Yes Yes No Yes Yes
## [120] Yes Yes Yes Yes No Yes No Yes Yes Yes No Yes Yes Yes Yes Yes No
## [137] No Yes Yes No Yes Yes Yes Yes No Yes Yes No No Yes No No No
## [154] No No Yes Yes No No No No No Yes No No Yes Yes Yes Yes Yes
## [171] Yes Yes Yes Yes No Yes No Yes No Yes Yes Yes Yes Yes No Yes No
## [188] Yes Yes No No Yes No Yes Yes Yes Yes Yes Yes Yes No Yes No Yes
## [205] Yes Yes Yes No Yes No No Yes Yes Yes Yes Yes Yes No Yes Yes Yes
## [222] Yes Yes Yes No Yes Yes Yes No No No No Yes No No Yes Yes Yes
## [239] Yes Yes Yes Yes No Yes Yes No Yes Yes Yes Yes Yes Yes Yes No Yes
## [256] Yes Yes Yes No No Yes Yes Yes Yes Yes Yes No No Yes Yes Yes Yes
## [273] Yes Yes Yes Yes Yes Yes No Yes Yes No Yes No No Yes No Yes No
## [290] Yes No Yes Yes Yes Yes No Yes Yes Yes No Yes Yes Yes Yes Yes Yes
## [307] Yes Yes Yes Yes Yes Yes Yes Yes Yes Yes Yes No No No Yes Yes Yes
## [324] Yes Yes Yes Yes Yes Yes Yes No Yes Yes Yes Yes Yes Yes Yes Yes Yes
## [341] Yes No No Yes No Yes No No Yes No No No Yes No Yes Yes Yes
## [358] Yes Yes Yes No No Yes Yes Yes No No Yes No Yes Yes Yes No Yes
## [375] Yes Yes Yes No Yes Yes Yes Yes Yes Yes Yes Yes Yes No Yes Yes Yes
## [392] Yes Yes No Yes Yes No Yes Yes Yes
## Levels: Yes Nohist(df_seats$Sales)
Se refactoriza la variable sales como 0 y 1, ya que es la que se evalúa como variable independiente. Se propone separar la varible sales entre sales<media(sales) como volumen de ventas bajo y sales>media(sales) como volumen de ventas alto.
df_logit_seats <- df_seats
library(dplyr)
df_logit_seats <- df_logit_seats %>%
mutate(Sales = ifelse(Sales < 7.41,0,1)) #Se configura la variable dependiente como 0, 1 para poder realizar el ajuste de regresión logística.
RLOG_sales <- glm(Sales~Price + Advertising +Age + Population + ShelveLoc + US + Urban, data = df_logit_seats, family = binomial(link = "logit"))
summary(RLOG_sales)##
## Call:
## glm(formula = Sales ~ Price + Advertising + Age + Population +
## ShelveLoc + US + Urban, family = binomial(link = "logit"),
## data = df_logit_seats)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.09817 -0.67456 0.06585 0.62907 2.52526
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 7.718e+00 1.148e+00 6.722 1.79e-11 ***
## Price -6.699e-02 8.102e-03 -8.268 < 2e-16 ***
## Advertising 1.321e-01 3.125e-02 4.226 2.38e-05 ***
## Age -4.703e-02 8.949e-03 -5.255 1.48e-07 ***
## Population 5.952e-05 9.643e-04 0.062 0.951
## ShelveLocGood 4.230e+00 5.398e-01 7.837 4.62e-15 ***
## ShelveLocMedium 1.672e+00 3.512e-01 4.759 1.95e-06 ***
## USYes -2.154e-01 3.966e-01 -0.543 0.587
## UrbanYes 1.886e-01 3.082e-01 0.612 0.541
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 554.43 on 399 degrees of freedom
## Residual deviance: 341.99 on 391 degrees of freedom
## AIC: 359.99
##
## Number of Fisher Scoring iterations: 53.2. Interpretar el modelo
Interpretar el modelo ajustado:
- ¿Cuál es la calidad del ajuste?
Se puede ver que la calidad del ajuste es buena ya que el error standard de todas las variables es muy bajo.
- Explicad la contribución de las variables explicativas en el modelo.
Los coeficientes del ajuste son los que estan en la columna estimate. Para poder interpretar los coeficientes, se calcula el logaritmo de los mismos.
exp(coefficients(RLOG_sales))## (Intercept) Price Advertising Age
## 2248.7981005 0.9352072 1.1411724 0.9540619
## Population ShelveLocGood ShelveLocMedium USYes
## 1.0000595 68.7451028 5.3205974 0.8062392
## UrbanYes
## 1.2075211Si el exponencial del coeficiente es exp(coef)>1, la probabilidad de éxito es mayor que la de fracaso, y a la inversa si exp(coef)<1. Solo se han de interpretar las variables que sean significativas en el ajuste. Estas son las variables marcadas con *** en la columna Pr(>|z|).
Por ello, excluimos el analisis de los coeficientes de Population, USYes y UrbanYes.
Price: coef = 0,93. Por cada unidad de coste que disminuya el precio, la probabilidad de aumentar el volumne de venta aumenta en un (1-0,93)*100 = 7%.
Advertising: coef = 1,14. Por cada unidad invertida en publicidad, existe un 14% de probabilidad de aumentar el volumen de venta.
Age: coef = 0,95. Por cada año que disminuye la edad, la probabilidad de aumentar el volumne de venta aumenta en un (1-0,95)*100 = 5%.
ShelveLocGood: coef >>>> 1. La variable de localización en tienda es muy significativa en el volumen de compra.
ShelveLocMedium: coef >> 5,3. La variable de localización en tienda es significativa en el volumen de compra, aunque en menor medida que ShelveLocGood.
Ecuación del modelo:
varNames <- colnames(model.matrix(RLOG_sales))
equationStr <- paste(round(coef(RLOG_sales),2),varNames,sep="*",collapse=" + ")
equationStr <- gsub("*(Intercept)","",equationStr,fixed=TRUE)
equationStr <- paste(RLOG_sales$terms[[2]],"=",equationStr)
equationStr## [1] "Sales = 7.72 + -0.07*Price + 0.13*Advertising + -0.05*Age + 0*Population + 4.23*ShelveLocGood + 1.67*ShelveLocMedium + -0.22*USYes + 0.19*UrbanYes"3.3. Predicción
Aplicar el modelo de regresión para predecir Sales de:
-una tienda fuera de USA en una zona rural, con precio de 131 dólares, Advertising de 0 dólares, Population de 139.000 personas, Age 40 años y ShelveLoc de tipo Bad.
#Ecuacion del modelo: "Sales = 7.72 -0.07*Price + 0.13*Advertising -0.05*Age + 0*Population + 4.23*ShelveLocGood + 1.67*ShelveLocMedium - 0.22*USYes + 0.19*UrbanYes"
#probabilidad de ventas altas
prob_sales_1 <- exp(c(Sales = 7.72 -0.07*131 + 0.13*0 -0.05*40 + 0*139000))
prob_sales_1## Sales
## 0.03174564La probabilidad de un aumento de ventas con las variables evaluadas es del -3,1%.
-Comparar el resultado con el de una tienda fuera de USA en una zona rural, con precio 131 dólares, Advertising de 9.000 dólares, población de 139.000 personas, Age 40 años y ShelveLoc de tipo Good. Explicar las diferencias en función de los coeficientes del modelo de regresión.
#Ecuacion del modelo: "Sales = 7.72 -0.07*Price + 0.13*Advertising -0.05*Age + 0*Population + 4.23*ShelveLocGood + 1.67*ShelveLocMedium - 0.22*USYes + 0.19*UrbanYes"
#probabilidad de ventas altas
prob_sales_2 <- exp(c(Sales = 7.72 -0.07*131 + 0.13*9 -0.05*40 + 4.23*1))
prob_sales_2## Sales
## 7.028688La probabilidad de un aumento de ventas con las variables evaluadas es alta ya que prob>>1.
- Análisis de la varianza (ANOVA) de un factor
Vamos a realizar un análisis de varianza de un factor: concretamente analizamos la contribución de la variable ShelveLoc en la variable Sales.
4.1. Hipótesis nula y alternativa
Ho: media de la variable estudiada es la misma en los diferentes grupos H1: al menos dos medias difieren de forma significativa
4.3. Modelo
Calcular el análisis de varianza, usando la función aov o lm. Interpretar el resultado del análisis, teniendo en cuenta los valores Sum Sq, Mean Sq, F y Pr(>F).
sales <- df_seats$Sales
shelveloc <- df_seats$ShelveLoc
df_anova <- data.frame(cbind(sales, shelveloc))
stack_df_anova <- stack(df_anova)
plot(sales~shelveloc, data = stack_df_anova)
anova_results <- aov(sales~shelveloc, data= stack_df_anova)
summary(anova_results)## Df Sum Sq Mean Sq F value Pr(>F)
## shelveloc 2 832.8 416.4 77.02 <2e-16 ***
## Residuals 397 2146.5 5.4
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1p>0.05, las medias de las poblaciones son significativamente iguales
F(2,397) = 77.02, p<0.05
El contraste de hipótesis del ANOVA se basa en comprobar si las medias de las muestras difieren más de lo que cabe esperar cuando es cierta, la hipótesis nula.
Esta cuestión acerca de las medias se responde analizando las varianzas. Nos fijamos en las varianzas, porque, cuando queremos saber si algunas medias difieren entre sí, tenemos que valorar la varianza entre estas medias.
F = variabilidad entre grupos / variabilidad intra grupos
4.4. Cálculos
Para profundizar en la comprensión del modelo ANOVA, calculad manualmente la suma de cuadrados intra y la suma de cuadrados entre grupos.
F = CM(entre)/CM(intra)
CM(intra)=SC(intra)/gl(intra) [suma de cuadrados en sus grados de libertad, lo mismo para CM(entre)]
Se calcula:
s^2 = sum(x-x(mean))/(n-1) = SC/gl
SC(entre)=sum(xi - total_mean)/n-1 SC(intra)=sum(xij - mean)/n-1
SC(total) = SC(entre) + SC(intra) gl(total) = gl(entre) + gl(intra)
4.5. Efectos de los niveles
Proporcionad la estimación de los efectos de los niveles del factor ShelveLoc. También, proporcionad la estimación de la varianza del error.
#Efectos de los niveles
efecto <- 832.8/2146.5
efecto## [1] 0.3879804el efecto de los niveles se puede interpretar como porcentaje de variabilidad explicada en las ventas debido a los distintos valores de ShelveLoc (bad. medium, good). Parece que el análisis aisaldo de estas dos variables arroja que la colocación en la tienda no afecta de manera muy significativa ya que efecto << 1.
La varianza del error:
- Cuadrados Medios del Error = Intravarianza (varianza dentro de los niveles, conocida como varianza residual o de error) = 5,4
Una de las condiciones para que el ANOVA de una via arroje buenos resultados es la independecia de sus datos. Se requiere que las observaciones deben ser aleatorias, el tamaño total de la muestra de cada grupo debe de ser < 10% de la población a la que representay que los grupos (niveles del factor) deben de ser independientes entre ellos.
Una intravarianza de 5.4 es una varianza pequeña y puede ser un indicador de la no independencia de los niveles del factor.
4.7. Adecuación del modelo
Mostrar visualmente la adecuación del modelo ANOVA. Podéis utilizar plot sobre el modelo ANOVA resultante. En los apartados siguientes se pide la interpretación de estos gráficos.
plot(anova_results)
El gráfico Q-Q, o gráfico cuantil-cuantil, es una herramienta gráfica que nos ayuda a evaluar si un conjunto de datos proviene de alguna distribución teórica, como Normal o exponencial. Por ejemplo, si ejecutamos un análisis estadístico que asume que nuestra variable dependiente está normalmente distribuida, podemos usar un gráfico Q-Q normal para verificar esa suposición. En el gráfico que se presenta en el resultado del anova, se puede ver como los puntos que conforman el gráfico Q-Q forman una linea homogénea entre ellos. Así, se puede asumir que los datos utilizados siquen una distribución normal.
La homocedasticidad, es una característica de un modelo de regresión lineal que implica que la varianza de los errores es constante a lo largo del tiempo.
Cuando se realiza un análisis residual, una “gráfica de residuos versus valores esperados” es la gráfica creada con más frecuencia. Es un diagrama de dispersión de los residuos en el eje y y los valores ajustados (respuestas estimadas) en el eje x. El gráfico se utiliza para detectar no linealidad, variaciones de error desiguales y valores atípicos. En la gráfica residuals vs Fitted values generada, se puede ver que los valores residuales se reparten de manera homogenea y se separan en los tres grupos esperados. Se puede observar también que para uno de los grupos pueden existir valores outliers.
El gráfico Scale location es similar al Residual vs Fitted a nivel interpretativo, ya que representa el cuadrado de los residuos versus los valores esperados. Se observa que a línea roja (media de los valores residuales) es aproximadamente horizontal. Entonces, la magnitud promedio de los residuos estandarizados no está cambiando mucho en función de los valores ajustados, algo que no ayuda a aceptar la asunción de homocedasticidad.
Por último, en el caso del plot Residuals vs Leverage, se puede ver que la linea roja corresponde a la distanca de Cook, que expresa la distancia entre grupos de clasificación. Se puede ver que hay dos grupos más próximos entre ellos en cuanto a sus caracterísitcas (en este caso, ventas similares en función de la localización).
- ANOVA multifactorial
A continuación, se quiere evaluar el efecto de más de un factor sobre la variable Sales donde el primer factor siempre será ShelveLoc. Primero, realizaremos el análisis con ShelveLoc y US en relación a las ventas (Sales). Posteriormente, el análisis multifactorial será con ShelveLoc y Urban en relación a Sales.
5.1.1. Análisis visual de los efectos principales y posibles interacciones
Dibujar en un gráfico la variable Sales en función de ShelveLoc y en función de US. El gráfico debe permitir evaluar si hay interacción entre los dos factores.
library(ggplot2)
library(magrittr)
library(dplyr)
# Step 1
df_seats %>%
#Step 2
group_by(ShelveLoc, US) %>%
#Step 3
summarise(mean_sales = mean(Sales)) %>%
#Step 4
ggplot(aes(x = ShelveLoc, y = mean_sales, fill = US)) +
geom_bar(stat = "identity") +
theme_classic() +
labs(
x = "ShelveLoc + US ",
y = "Average sales",
title = paste(
"Mean of sales vs ShelveLoc and US"
)
)
library(ggplot2)
library(magrittr)
library(dplyr)
# Step 1
df_seats %>%
#Step 2
group_by(ShelveLoc, Urban) %>%
#Step 3
summarise(mean_sales = mean(Sales)) %>%
#Step 4
ggplot(aes(x = ShelveLoc, y = mean_sales, fill = Urban)) +
geom_bar(stat = "identity") +
theme_classic() +
labs(
x = "ShelveLoc + Urban ",
y = "Average sales",
title = paste(
"Mean of sales vs ShelveLoc and Urban"
)
)
5.1.2. Calcular el modelo
us <- df_seats$US
urban <- df_seats$Urban
df_anova_2 <- data.frame(cbind(sales, shelveloc, us))
stack_df_anova_2 <- stack(df_anova_2)
df_anova_3 <- data.frame(cbind(sales, shelveloc, urban))
stack_df_anova_3 <- stack(df_anova_3)
plot(sales~shelveloc+us, data = stack_df_anova_2)
plot(sales~shelveloc+urban, data = stack_df_anova_3)
anova_multi <- aov(sales~shelveloc+us, data= stack_df_anova_2)
summary(anova_multi)## Df Sum Sq Mean Sq F value Pr(>F)
## shelveloc 2 832.8 416.4 81.20 < 2e-16 ***
## us 1 115.7 115.7 22.56 2.85e-06 ***
## Residuals 396 2030.8 5.1
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Cuando la hipótesis nula es cierta SCE/K-1 y SCD/n-K son dos estimadores insesgados de la varianza poblacional y el cociente entre ambos se distribuye según una F de Snedecor con K-1 grados de libertad en el numerador y N-K grados de libertad en el denominador. Por lo tanto, si H0 es cierta es de esperar que el cociente entre ambas estimaciones será aproximadamente igual a 1, de forma que se rechazará H0 si dicho cociente difiere significativamente de 1.
Las medias de las poblaciones son significativamente diferentes ya que F es significativamente diferente de 1.
832.8/115.7## [1] 7.197926F(2,1) = 81,20, p<0.05
F = variabilidad entre grupos / variabilidad intra grupos
anova_multi_urban <- aov(sales~shelveloc+urban, data= stack_df_anova_3)
summary(anova_multi)## Df Sum Sq Mean Sq F value Pr(>F)
## shelveloc 2 832.8 416.4 81.20 < 2e-16 ***
## us 1 115.7 115.7 22.56 2.85e-06 ***
## Residuals 396 2030.8 5.1
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1las medias de las poblaciones son significativamente diferentes con el valores de F obtenido.
832.8/0.6## [1] 1388el valor de eta^2 del segundo modelo es muy alto, y por lo tanto la calidad del modelo es muy baja.
F(2,1) = 76.85, p<0.05
F(modelo_us) > F (modelo_urban)
F = variabilidad entre grupos / variabilidad intra grupos
Una F mayor implica un aumento de la variabilidad entre grupo y/o una disminución de la variabilidad intragrupos.
plot(anova_multi)
Normal Q-Q: La distribución de los datos es normal.
Residuals vs fitted: se pueden ver la posible existencia de valores outlier en alguno de los conjuntos de datos. La media de los residuos se mantiene muy cercana a 0.
Es un conjunto de datos homocedastico.
plot(anova_multi_urban)
Se observa una menor variabilidad en el error en el modelo anova_multi_urban. La distribución de los datos en el gráfico Normal Q-Q es mejor que en el modelo anterior.
- Comparaciones múltiples
library(DescTools)## Warning: package 'DescTools' was built under R version 3.6.2PostHocTest(anova_multi, which = NULL,
method = c("scheffe"),
conf.level = 0.95, ordered = FALSE)##
## Posthoc multiple comparisons of means: Scheffe Test
## 95% family-wise confidence level
##
## $shelveloc
## diff lwr.ci upr.ci pval
## Good-Bad 4.284730 3.337826 5.231635 < 2e-16 ***
## Medium-Bad 1.783659 1.005426 2.561892 1.4e-08 ***
## Medium-Good -2.501072 -3.313560 -1.688583 8.9e-15 ***
##
## $us
## diff lwr.ci upr.ci pval
## Yes-No 1.120046 0.4557097 1.784383 7.1e-05 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1library(DescTools)
PostHocTest(anova_multi_urban, which = NULL,
method = c("scheffe"),
conf.level = 0.95, ordered = FALSE)##
## Posthoc multiple comparisons of means: Scheffe Test
## 95% family-wise confidence level
##
## $shelveloc
## diff lwr.ci upr.ci pval
## Good-Bad 4.284730 3.3113568 5.258104 < 2e-16 ***
## Medium-Bad 1.783659 0.9836716 2.583646 3.8e-08 ***
## Medium-Good -2.501072 -3.3362720 -1.665871 4.7e-14 ***
##
## $urban
## diff lwr.ci upr.ci pval
## Yes-No 0.08264704 -0.6339084 0.7992025 0.9912
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1La prueba de Scheffe (también llamada procedimiento de Scheffe o método de Scheffe) es una prueba post-hoc utilizada en el análisis de varianza. Después de ejecutar ANOVA y obtener una estadística F significativa (es decir, rechazó la hipótesis nula de que las medias son las mismas), ejecuta la prueba de Sheffe para descubrir qué pares de medias son significativas. La prueba de Scheffe corrige alfa para comparaciones medias simples y complejas. Las comparaciones medias complejas implican comparar más de un par de medias simultáneamente.
CONCLUSIONES:
Se ha evaluado el set de datos de ventas de sillas en función de diferentes parámetros registrados por la empresa interesada. La primera parte de la actividad se centra en la visualización de los datos en forma de diferentes gráficos para encontrar posibles relaciones causales.
La segunda parte, se centra en la inferencia estadística. Se realiza una regresión logística para determinar que variables son más significativas en el aumento de las ventas de sillas. Se ha visto que una de las variables más influyentes es la localización de las sillas en la tienda.
Por último, se ha realizado un análisis anova para el análisis de las ventas respecto a la localización del producto en la tienda y tambien respecto a la variable urban y us. Se han elaborado dos modelos distintos para evaluar estas dos ultimas variables.
Los dos modelos nos dicen que las medias de los conjuntos de datos analizados son significativamente diferentes para cada nivel de las variables categóricas incluidas en los modelos.